HPAVC/HPAVC CD-ROM.iso/pc/HUNCHY.ZIP/HB.PAS

Pascal/Delphi Source File | 1994-03-17 | 24.3 KB | 1,023 lines

program HUNCHBACK;

uses Dos,Crt,Graph3,Graph;

const
  On=True;
  Off=False;
  Hdir='';
  Icons=19;
  Walls=12;
  MaxWeapon=20;
  GrdIcn:array[1..10] of byte=(14,14,15,15,16,16,16,15,15,14);
  No:array[1..10] of byte=(1,2,3,2,4,5,6,5,7,8);
  Ad:array[1..10] of shortint=(0,2,0,2,0,4,2,4,-2,-9);

type
  ScrTyp=array[1..16368] of byte;
  IcnTyp=array[1..185] of byte;
  WpnTyp=record
    Typ,Yps:byte;
    Spd:shortint;
    Int,Del,Cnt,Xps:word;
    Fst:boolean;
  end;
  HiscTyp=array [1..7] of record
    Name:string[20];
    Scor:integer;
  end;
  Str80=string[80];
  Str255=string[255];

var
  Screen:ScrTyp absolute $B800:$0000;
  Icon:array[1..Icons] of IcnTyp;
  BlIcon:array[1..800] of byte;
  Regs:Registers;
  Ctr,Ctr2:word;
  Behind:IcnTyp;
  Gd,Gm,StringTop,
  ox,x,oy,y,NextXlife,
  Walk,OWlk,Wmin,Wmax,Pause,Score,
  Rx,Urx,Orx,Ourx,Bonus,BonCnt:integer;
  xd,oxd,yd,oyd,Rxd,Hanging:shortint;
  Jmp,GrdCnt,GrdNo,Weapons,WallNo,Lives,
  StartLevel,StartWall,Level,LastPos:byte;
  Key:char;
  Reached,Rope,Guards,Pits,LetGo,UseFont,
  Started,Falling,FirstFall,Dead,Quit,
  RgtShft,LftShft,NumLk,CapsLk,ScrlLk,Ins:boolean;
  Weapon:array[1..MaxWeapon] of WpnTyp;
  Wall:array[1..12,1..200] of integer;
  Octave,Tempo:byte;
  AllLength,Music:real;
  Step,TuneStopped,TitleMusic:boolean;
  Hisc:HiscTyp;
  HiscFil:file of HiscTyp;
  Publ,Auth,Adrs,City:Str80;


procedure GameFont; external;
{$L FONT.OBJ}


procedure Sound1(Frq:word);
begin
  if not ScrlLk then Sound(Frq);
end;

procedure Sound(Frq:word);
begin
  Sound1(Frq);
end;

procedure GetShiftStats;
begin
  with Regs do begin
    AH:=$2;
    Intr($16,Regs);
    RgtShft:=(AL and 1)=1;
    LftShft:=(AL and 2)=2;
    ScrlLk:=(AL and 16)=16;
    NumLk:=(AL and 32)=32;
    CapsLk:=(AL and 64)=64;
    Ins:=(AL and 128)=128;
  end;
end;

function St(Num:integer):Str80;
var Temp:Str80;
begin
  Str(Num,Temp);
  St:=Temp;
end;

{$I HPLAY.INC}

procedure Wnum(Value:integer; Nums,x,y:byte);
var
  St:Str80;
  Ctr:byte;               { The new font works only on 100% PC compatibles, }
  Ch:char;                { no ATs, then the original font is used }
begin
  Str(Value:Nums,St);
  GotoXY(x,y);
  for Ctr:=1 to Length(St) do begin
    Ch:=St[Ctr];
    if Ch=' ' then Ch:='0';
    if UseFont then if Ch in ['0'..'9'] then Inc(Ch,128);
    Write(Ch);
  end;
end;

procedure Wstr(Txt:Str255);
var
  Ctr:byte;
begin
  for Ctr:=1 to Length(Txt) do
    Write(Chr(Ord(Txt[Ctr])+(128*Ord(UseFont))));
end;

function GetInput(x,y,Len,Col:byte):Str80;
var
  Tmp:Str80;
  Pos:byte absolute Tmp;
  Key:char;
begin
  Pos:=0;
  TextColor(Col);
  Tmp:='';
  repeat
    GotoXY(x+Pos,y);
    Write(#150);
    Key:=ReadKey;
    case Ord(Key) of
      32..126:if Pos<Len then begin
        Write(#8,Chr(Ord(Key)+128));
        Inc(Pos);
        Tmp[Pos]:=Key;
      end;
      8:if Pos>0 then begin
        Write(#8#32);
        Dec(Pos);
      end;
    end;
  until (Key=#13) and (Tmp<>'');
  GetInput:=Tmp;
end;

function Smallest(A,B:integer):integer;
begin
  if A<B then Smallest:=A
  else Smallest:=B;
end;

procedure Count(var V:integer; Add,Low,High:word);
begin
  Inc(V,Add);
  if V<Low then V:=High;
  if V>High then V:=Low;
end;

procedure Black(x,y,xs,ys:word);
begin
  BlIcon[3]:=xs; BlIcon[5]:=ys;
  PutPic(BlIcon,x,y);
end;

function ImSize(x1,y1,x2,y2:word):word;
var
  x,y:word;
begin
  x:=x2-x1+1; Y:=y2-y1+1;
  ImSize:=(6+Trunc((x*2+7)/8)*y);
end;

procedure Box(x,y,x1,y1:word);
begin
  SetFillStyle(1,0);
  Bar(x,y,x1,y1);
  SetColor(2);
  MoveTo(x,y); LineTo(x,y1); LineTo(x1,y1);
  SetColor(1);
  LineTo(x1,y); LineTo(x,y);
end;

procedure OutLine(x,y:integer; Txt:Str80; OCol,TCol:byte);
var ax,ay:shortint;
begin
  SetColor(Ocol);
  for ay:=-1 to 1 do
    for ax:=-1 to 1 do if(ax<>0) or(ay<>0) then
      OutTextXY(x+ax,y+ay,Txt);
  SetColor(TCol);
  OutTextXY(x,y,Txt);
end;

procedure LoadHiScores;
var Ctr:byte;
begin
  Assign(HiscFil,Hdir+'HISC.DAT'); {$I-}
  Reset(HiscFil);                  {$I+}
  case(IOresult=0) of
    True:begin
      Read(HiscFil,Hisc);
      Close(HiscFil);
    end;
    False:for Ctr:=1 to 7 do with Hisc[Ctr] do begin
      case(Ctr mod 2=1) of
        True:Name:='Robert Schmidt';
        False:Name:='FireBall Software';
      end;
      Scor:=(11-Ctr)*200;
    end;
  end;
end;

procedure SaveHiScores;
begin
  Assign(HiscFil,Hdir+'HISC.DAT');
  ReWrite(HiscFil);
  Write(HiscFil,Hisc);
  Close(HiscFil);
end;

procedure Video(State:boolean);
begin
  case State of
    On:Port[$3d8]:=$A;      { Quick and dirty !! }
    Off:Port[$3d8]:=2;      { May not work on ATs }
  end;
end;

function Decode(Txt:Str80):Str80;  { Just a vacsine against pirates }
var Ctr:byte;
begin
  for Ctr:=1 to Length(Txt) do
    Dec(Txt[Ctr],128);
  Decode:=Txt;
end;

procedure Wlin(y:integer; Txt:Str255);
begin
  OutTextXY(160,y,Txt);
end;

procedure Initialize;
var
  IcnFil:file of byte;
  WalFil:file of integer;
  Tmp:IcnTyp;
  IconNo,WallNo:byte;
  Isize,Cnt:word;
  Dat,Gd,Gm:integer;
begin
  Randomize;
  NoSound;
  SetIntVec($1F,@GameFont);
  InitPlay;
    GraphColorMode;
    Gd:=CGA;
    Gm:=CGAC0;
    InitGraph(Gd,Gm,'');
  DirectVideo:=Off;
  Video(Off);
  GotoXY(1,1); Write(#150);
  UseFont:=(Screen[1]=255);
  ClearDevice;
  GotoXY(12,9); Wstr('Loading Hunchback...');
  TextColor(1);
  GotoXY(8,11); Wstr('Please wait a few seconds...');
  Video(On);
  Publ:=Decode('╞Θ≥σ┬ß∞∞á╙∩µ⌠≈ß≥σá╠⌠Σ');
  Auth:=Decode('╥∩Γσ≥⌠á╙πΦφΘΣ⌠');
  Adrs:=Decode('╧∞σá╬∩≥Στßß≥Σ≤÷σΘá┤┤');
  City:=Decode('╖░┤╣á╘≥∩εΣΦσΘφ¼á╬╧╥╫┴┘');
    GetPic(BlIcon,0,0,25,25);
  CheckEOF:=Off;
  CheckBreak:=Off;
  Assign(IcnFil,Hdir+'ICONS.DAT');
  Reset(IcnFil);
  IconNo:=1;
  while(not Eof(IcnFil)) and(IconNo<=Icons) do begin
    for Ctr:=1 to 6 do
      Read(IcnFil,Tmp[Ctr]);
    Isize:=ImSize(1,1,Tmp[4]*256+Tmp[3],Tmp[6]*256+Tmp[5]);
    for Ctr:=7 to Isize do
      Read(IcnFil,Tmp[Ctr]);
    Icon[IconNo]:=Tmp;
    Inc(IconNo);
  end;
  Close(IcnFil);
  FillChar(Wall,SizeOf(Wall),#0);
  Assign(WalFil,Hdir+'WALL.DAT');
  Reset(WalFil);
  WallNo:=0;
  Read(WalFil,Dat);
  while(not Eof(WalFil)) and(WallNo<Walls) do begin
    if Dat=MaxInt then begin
      Inc(WallNo);
      Cnt:=1; repeat
        Read(WalFil,Dat);
        if Dat<>MaxInt then Wall[WallNo,Cnt]:=Dat;
        Inc(Cnt);
      until(Dat=MaxInt) or Eof(WalFil);
      Writeln;
    end;
  end;
  LoadHiScores;

  Video(Off);
  ClearDevice;
  SetTextJustify(CenterText,TopText);
  SetTextStyle(GothicFont,0,5);
  SetColor(2); OutTextXY(158,-3,'HUNCHBACK');
  SetColor(3); OutTextXY(160,-5,'HUNCHBACK');
  SetTextStyle(TriplexFont,0,0);
  SetUserCharSize(2,3,2,5);
  SetColor(1); Wlin(34,'Version 1.02');
  SetUserCharSize(1,2,1,2);
  SetColor(2); Wlin(45,'Programming, graphics and sound by');
  Wlin(85,'Copyright (C) 1988 & 1989 of');
  SetUserCharSize(7,10,7,10);
  SetColor(3); Wlin(62,Auth);
  Wlin(101,Copy(Publ,1,17)+' Limited');
  SetTextStyle(SmallFont,0,0);
  SetUserCharSize(1,1,1,1);
  SetColor(2); Wlin(122,'Write to: '+Publ+', c/o '+Auth+',');
  Wlin(131,Adrs+', '+City);
  SetUserCharSize(1,1,1,1);
  SetColor(1);
  Wlin(145,'This product is distributed under the FreeWare Concept.');
  Wlin(155,'You may therefore freely share a copy of the program');
  Wlin(165,'to your friends, but without demanding any kind of fee');
  Wlin(175,'or payment. If you enjoy the game, a contribution of');
  Wlin(185,'approximately $15 will be most appreciated.');
  Video(On);

  SetTextJustify(LeftText,TopText);
  LastPos:=0;
  StartLevel:=1; StartWall:=1;
  Dead:=False; Quit:=False;
  Key:=ReadKey;
end;

procedure ShowTitle;
var
  Ctr,Col,Rank:byte;
  PrevSc:integer;
  TitFil:file of ScrTyp;
  Slch,Swch:char;
begin
  TitleMusic:=On;
  TuneStopped:=False;
  Assign(TitFil,Hdir+'TITLE.PIC');
  Reset(TitFil);
  Video(Off);
  ClearDevice;
  Read(TitFil,Screen);
  Video(On);
  Close(TitFil);
  Play('t160 o3 l8');
  repeat
    Ctr:=1;
    repeat
      case Ctr of
        1:Octave:=3;
        2:Octave:=5;
        3:Octave:=1;
      end;
      Play('a>c4de.f#16ed4<bg.a16b>c4<aa.g16ab4ge4'+
           'a>c4de.f#16ed4<bg.a16b>c.<b16ag#.f#16g#a4.a4p'+
           '>g4.g.f#16ed4<bg.a16b>c4<aa.g#16ab4g#e4.'+
           '>g4.g.f#16ed4<bg.a16b>c.<b16ag#.f#16g#a4.a4p4');
      Inc(Ctr);
    until(Ctr>3) or TuneStopped;
  until TuneStopped;

  while KeyPressed do Key:=ReadKey;
  TitleMusic:=Off;
  TuneStopped:=False;
  Video(Off);
  ClearDevice;
  SetTextJustify(CenterText,TopText);
  SetTextStyle(GothicFont,0,4);
  SetColor(3); Wlin(-7,'Hunchback');
  SetTextStyle(GothicFont,0,2);
  OutTextXY(40,148,'Hall Of');
  OutTextXY(40,168,'Fame');
  SetTextStyle(SmallFont,0,4);
  SetTextJustify(LeftText,TopText);
  PrevSc:=0; Rank:=0;
  for Ctr:=1 to 7 do begin
    Col:=1+Ord(Ctr=LastPos)*2;
    TextColor(Col);
    with Hisc[Ctr] do begin
      GotoXY(12,Ctr+18);
      if Scor<>PrevSc then Inc(Rank);
      Wstr(St(Rank)+' '+Name);
      Wnum(Scor,5,35,Ctr+18);
      PrevSc:=Scor;
    end;
  end;
  SetTextStyle(SmallFont,0,4);
  SetTextJustify(CenterText,TopText);
  SetColor(2);
  Wlin(26,'In this game, you play the role of Quasimodo, whose');
  Wlin(34,'purpose is to reach the other end of the huge castle');
  Wlin(42,'wall, where the beautiful princess Esmeralda is kept');
  Wlin(50,'captured in the castle tower. To continue to the next');
  Wlin(58,'part of the wall, you''ll have dodge several obstacles');
  Wlin(66,'to reach the bell and ring it. Watch out for arrows,');
  Wlin(74,'cannonballs and stabbing guards.');
  Wlin(82,'To make Quasimido walk, use the left and right SHIFT');
  Wlin(90,'keys. Press Enter or Spacebar to jump.');
  SetColor(1);
  OutTextXY(65,100,'Choose skill level:');
  OutTextXY(65,108,'(Press 1-3)');
  OutTextXY(210,100,'Choose start wall:');
  OutTextXY(210,108,'(Press A-L)');
  SetColor(2);
  Rectangle(124,101,145,119);
  Rectangle(267,101,287,119);
  SetColor(3); Wlin(119,'Press Enter or Spacebar to start, ESC to quit.');
  SetColor(2); Wlin(129,'Scroll Lock toggles sound, Num Lock toggles pause.');
  SetColor(3); SetTextStyle(GothicFont,0,2);
  SetTextJustify(LeftText,TopText);
  Video(On);
  repeat
    Slch:=Chr(48+StartLevel);
    Swch:=Chr(64+StartWall);
    OutTextXY(130,99,Slch);
    OutTextXY(270,99,Swch);
    Key:=UpCase(ReadKey);
    case Key of
      '1'..'3':begin
        StartLevel:=Ord(Key)-48;
        Black(130,117,15,15);
      end;
      'A'..'L':begin
        StartWall:=Ord(Key)-64;
        Black(270,117,15,15);
      end;
    end;
  until Key in [#13,#32,#27];
  if Key=#27 then Quit:=True;
  SetTextStyle(DefaultFont,0,1);
end;

procedure ScrollLeft;
type
  ScrHalf=array [0..100,0..79] of byte;
var
  Scr1:ScrHalf absolute $B800:0000;
  Scr2:ScrHalf absolute $B800:8112;
  Line:byte;
begin
  for Line:=0 to 100 do begin
    Move(Scr1[Line,4],Scr1[Line,0],80);
    Move(Scr2[Line,4],Scr2[Line,0],80);
  end;
(*  Move(Screen[5],Screen,16384);*)
end;

procedure Game;
  procedure BellString;
  begin
    SetColor(3);
    Line(307,StringTop,307,93);
  end;

  procedure TurnLeft;
  begin
    if not(Walk in [1..4]) then begin
      Walk:=2;
      Wmin:=1; Wmax:=4;
    end;
    xd:=-1;
  end;

  procedure TurnRight;
  begin
    if not(Walk in [5..8]) then begin
      Walk:=6;
      Wmin:=5; Wmax:=8;
    end;
    xd:=1;
  end;

  procedure Man;
  begin
    if Falling then begin
      Sound((400-y)*5);
      Inc(y,7+4*Ord(y>127));
      if y>200 then Dead:=True;
      if oy>103 then PutPic(Behind,ox,oy);
      if oy<122 then Black(ox,Smallest(103,oy),17,19);
      GetPic(Behind,x,y,x+14,y-18);
    end else begin
      if(Owlk<>Walk) or(oy<>y) or(ox<>x) then Black(ox+Ad[Owlk],oy,15,19);
      if Reached then BellString;
    end;
    PutPic(Icon[No[Walk]],x+Ad[Walk],y);
  end;

  procedure ShowGuards;
  var
    xp:word;
    Gicn:IcnTyp;
  begin
    for Ctr:=1 to 3 do begin
      xp:=Ctr*80-8;
      if Ctr=GrdNo then begin
        Gicn:=Icon[GrdIcn[GrdCnt]];
        if GrdCnt>7 then Black(xp,119-GIcn[5],3,6);
        if(xp>x-1)and(xp<x+15)and(GrdIcn[GrdCnt]>14) then Falling:=True;
      end else Gicn:=Icon[14];
      PutPic(Gicn,xp,119);
    end;
  end;

  procedure ShowLives;
  var Ctr:byte;
  begin
    if Lives>1 then for Ctr:=1 to Lives-1 do
      PutPic(Icon[4],(Ctr-1)*19,17);
  end;

  procedure KillLife;
  var Ctr:byte;
  begin
    Dec(Lives);
    if Lives>0 then begin
      SetColor(0);
      for Ctr:=18 to 103 do begin
        PutPic(Icon[4],0,Ctr);
        Line(5,Ctr-18,13,Ctr-18);
        Delay(2);
      end;
      Play('t200 l8 o3 e4ep64eeea2');
    end;
    Black((Lives-1)*19,17,15,18);
    ShowLives;
  end;

  procedure ShowScore(Adj:integer; Cnt:boolean);
  var Ctr:integer;
    procedure Wsc;
    begin
      TextColor(3);
      Wnum(Score,5,15,2);
    end;
  begin
    case Cnt of
      True:begin
        for Ctr:=1 to Adj div 10 do begin
          Inc(Score,10);
          Wsc;
          Delay(10);
        end;
        Inc(Score,Adj mod 10);
        Wsc;
      end;
      False:begin
        Inc(Score,Adj);
        Wsc;
      end;
    end;
    if Score>=NextXlife then begin
      if Lives<6 then begin
        Inc(Lives);
        ShowLives;
        Play('t200 l4 o5 cc8ceg>c2');
      end;
      Inc(NextXlife,1500);
    end;
  end;

  procedure ShowBonus;
  begin
    TextColor(3);
    Wnum(Bonus,3,27,20);
  end;

  procedure ShowMap;
  begin
    OutLine(78,132,'Wall '+Chr(64+WallNo),0,1);
    Box(62,141,141,168);
    TextColor(2);
    GotoXY(9,21); Write(#138#139#139#139#139#139#139#139#139);
    GotoXY(16,20); Write(#142#139);
    GotoXY(16,19); Write(#140#141);
    PutPic(Icon[17],70+4*WallNo,159);
  end;

  procedure ClearObstacles;
  begin
    if Weapons>0 then for Ctr:=1 to Weapons do with Weapon[Ctr] do
      Black(Xps,Yps,Icon[10+Typ,3],Icon[10+Typ,5]);
    if Rope then begin
      SetColor(0); Line(Urx,20,Rx,76);
    end;
    if Guards then for Ctr:=1 to 3 do
      Black(Ctr*80-8,119-Icon[14,5],3,12);
  end;

  procedure InitGame;
  begin
    Lives:=4;
    Level:=StartLevel;
    Score:=0;
    NextXlife:=1500;
    WallNo:=StartWall;
    Reached:=True;
    Started:=True;
  end;

  procedure NewWall;
    procedure GetWallData;
    var
      WeapNo:byte;
    begin
      Rope:=Off; Guards:=Off; Pits:=Off;
      case Wall[WallNo,1] of
        1:Rope:=On;
        2:begin
          Guards:=On;
          Pits:=On;
        end;
        3:Pits:=On;
      end;
      Weapons:=Wall[WallNo,2];
      if Weapons>0 then begin
        Ctr:=3; WeapNo:=1;
        repeat
          with Weapon[WeapNo] do begin
            Typ:=Wall[WallNo,Ctr];
            Yps:=Wall[WallNo,Ctr+1];
            Spd:=Wall[WallNo,Ctr+2];
            Int:=Wall[WallNo,Ctr+3];
            Del:=Wall[WallNo,Ctr+4];
          end;
          Inc(Ctr,5);
          Inc(WeapNo);
        until WeapNo>Weapons;
      end;
    end;
    procedure SideWall(BrX,BrY:byte);
    var x,y:word;
    begin
      x:=BrX*16; y:=BrY*16+8;
      Line(x,y,x,y+16);
      Line(x+1,y,x+1,y+16);
    end;
    procedure Brick(BrX,BrY:byte);
    begin
      PutPic(Icon[9],BrX*16,BrY*16+23);
    end;
  begin
    LetGo:=False;
    SetColor(3);
    GetWallData;
    for Ctr:=0 to 19 do begin
      for Ctr2:=0 to 13 do Black(0,Ctr2*16,16,16);
      ScrollLeft;
      if(WallNo=Walls) and(Ctr>=17) then begin
        Brick(19,0);
        Brick(19,3);
        MoveTo(304,24); LineRel(16,0);
        MoveRel(0,1); LineRel(-16,0);
        case Ctr of
          17:begin Brick(19,1); SideWall(19,1);
            Brick(19,2); SideWall(19,2);
            SideWall(19,0); SideWall(19,3);
          end;
          18:begin SideWall(19,1); SideWall(19,2); end;
        end;
        Black(304,73,16,8);
      end;
      for Ctr2:=6 to 11 do begin
        if not((Rope and(Ctr2=6) and(Ctr in [4..14]))
        or(Pits and(Ctr2=6) and(Ctr in [4,5,9,10,14,15]))) then
          Brick(19,Ctr2);
        if Ctr2=6 then begin
          if Rope then if Ctr in [4,15] then SideWall(19,Ctr2);
          if Pits then if Ctr in [4,6,9,11,14,16] then SideWall(19,Ctr2);
        end;
      end;
    end;
    if WallNo<Walls then begin
      PutPic(Icon[10],300,20); StringTop:=21;
    end else begin
      PutPic(Icon[18],308,55); StringTop:=50;
    end;
    if Guards then ShowGuards;
    SetColor(2);
    OutTextXY(112,0,'Score');
    OutTextXY(175,1,'Hi');
    ShowScore(0,Off);
    BellString;
    ShowMap;
    ShowLives;
    Bonus:=500; BonCnt:=0;
    Box(199,149,239,161);
    OutLine(200,140,'Bonus',0,1);
    ShowBonus;
    if Started then begin
      KillLife;
      Started:=False;
    end;
  end;

  procedure InitWall;
  begin
    FirstFall:=True;
    x:=0; y:=103; xd:=0; yd:=0;
    ox:=x; oy:=y; oxd:=xd; oyd:=yd;
    Jmp:=0;
    Walk:=5; Wmin:=5; Wmax:=8;
    if Reached then NewWall;
    Reached:=False;
    Hanging:=0; LetGo:=False;
    if Rope then begin
      Rx:=Random(97)+104; Urx:=Rx; Rxd:=-1+Random(2)*2;
    end;
    if Guards then begin
      GrdCnt:=0;
      GrdNo:=0;
      ShowGuards;
    end;
    Falling:=False; Dead:=False;
    Man;
    if Weapons>0 then for Ctr:=1 to Weapons do with Weapon[Ctr] do begin
      Fst:=True; Cnt:=1;
    end;
  end;

  procedure ProcessJump;
  const
    JmpLen=8;
    Ychg:array[1..JmpLen] of shortint=(-8,-6,-3,-2,2,3,6,8);
  begin
    if Rope and not LetGo then if(Rx in [x..x+15]) and(y<101) then begin
      case xd of
        -1:Hanging:=1;
        +1:Hanging:=2;
      end;
      ShowScore(5,Off);
      xd:=0;
      Walk:=Hanging+8;
    end;
    if Hanging=0 then begin
      if Jmp=JmpLen+2 then begin
        Inc(y,7);
        if y>=103 then begin
          y:=103;
          Dec(Jmp);
        end;
      end else begin
        Inc(y,Ychg[Jmp]);
        if Jmp<6 then Sound(Jmp*150+500);
        Inc(Jmp);
      end;
      if Jmp=JmpLen+1 then begin
        if y<103 then Inc(Jmp) else begin
          Jmp:=0;
        end;
      end;
    end;
  end;

  procedure ProcessWpn;
    procedure MoveWpn(W:byte);
    var wx,wy:word;
    begin
      with Weapon[W] do begin
        if Typ=1 then Black(Xps,Yps,14,9)
        else Black(Xps,Yps,20,3);
        Inc(Xps,Spd);
        if(Xps>320) then Cnt:=1
        else begin
          wx:=Xps; wy:=Yps;
          PutPic(Icon[Typ+10],wx,wy);
          case Typ of
            1:if((wx>x-12)and(wx<x+14)) and((wy>y-18)and(wy<y+8)) then
              Falling:=True;
            2,3:if((wx>x-18)and(wx<x+14)) and((wy>y-18)and(wy<y+2)) then
              Falling:=True;
          end;
        end;
      end;
    end;
  begin
    for Ctr:=1 to Weapons do with Weapon[Ctr] do begin
      if Cnt=0 then MoveWpn(Ctr)
      else begin
        Inc(Cnt);
        if Cnt>=Del+(Ord(Fst)*Int) then begin
          Cnt:=0;
          Xps:=320*Ord(Spd<0);
          Fst:=False;
          if Typ=1 then Sound(100) else Sound(900);
        end;
      end;
    end;
  end;

  procedure ProcessRope;
  begin
    Orx:=Rx; Ourx:=Urx;
    Inc(Rx,Rxd*4);
    if(Rx<100) or(Rx>204) then Rxd:=-Rxd;
    Urx:=Round(152+(Rx-152) / 1.2);
    SetColor(0); Line(Ourx,20,Orx,76);
    SetColor(3); Line(Urx,20,Rx,76);
  end;

  procedure ProcessGuards;
  begin
    if not(GrdNo in [1..3]) then GrdNo:=1;
    Inc(GrdCnt);
    if GrdCnt>10 then begin
      GrdCnt:=1;
      Inc(GrdNo);
      Sound(50);
    end;
    ShowGuards;
  end;

  procedure PlayWall;
  begin
    while KeyPressed do Key:=ReadKey;
    Key:=#0;
    repeat
      ox:=x; oy:=y;
      oxd:=xd; oyd:=yd;
      Owlk:=Walk;
      GetShiftStats;
      if(Jmp=0) and(Hanging=0) and not Falling then begin
        if RgtShft then TurnRight else
        if LftShft then TurnLeft else xd:=0;
      end;
      if KeyPressed then begin
        Key:=ReadKey;
        if not Falling then case Key of
          #32,#13:if Jmp=0 then Jmp:=1 else if(Hanging>0) then begin
            Hanging:=0; xd:=Rxd; Jmp:=1;
            if xd<0 then TurnLeft else TurnRight;
            LetGo:=True;
          end;
        end;
        while KeyPressed do Key:=ReadKey;
      end else Key:=#0;
      if xd<>0 then begin
        Count(Walk,1,Wmin,Wmax);
        if not((Jmp>0) or Falling) then if Walk in [2,4,6,8] then
          Sound(85);
      end;
      if(Hanging=0) then begin
        if(xd<>0) then Inc(x,4*xd);
        if x<0 then x:=0;
      end else x:=Rx;
      if(Jmp>0) and(Hanging=0) then ProcessJump;
      if(x>=296) and not Falling then begin
        Reached:=True;
        if y<103 then begin Walk:=10; x:=308;
        end else x:=296;
      end;
      Man;
      Inc(BonCnt);
      if BonCnt=4 then begin
        BonCnt:=0;
        Dec(Bonus,10);
        if Bonus<0 then Bonus:=0;
        ShowBonus;
      end;
      Delay((4-Level)*25-10);
      if not Reached then begin
        if Weapons>0 then ProcessWpn;
        if Rope then ProcessRope;
        if Guards then ProcessGuards;
        BellString;
      end;
      if y=103 then begin
        if Rope then if(x>64)and(x<224) then Falling:=True;
        if Pits then
          if(x>64)and(x<88) or(x>144)and(x<168) or(x>224)and(x<248) then
            Falling:=True;
        if LetGo and not Falling then begin
          ShowScore(10,Off);
          LetGo:=False;
        end;
      end;
      if Falling and(Hanging>0) then begin
        case Rxd of
          -1:TurnLeft;
          +1:TurnRight;
        end;
        Hanging:=0;
        LetGo:=True;
        SetColor(3);
        Black(Ox+Ad[Owlk],oy,17,19);
      end;
      if Key=#27 then Quit:=True;
      NoSound;
      if NumLk then repeat GetShiftStats until not NumLk;
    until Reached or Dead or Quit;
  end;

  procedure DoEsmeralda;
  var
    Nman:IcnTyp;
    my:word;
  begin
    Black(x,y,16,19);
    BellString;
    x:=298;
    PutPic(Icon[8],x,y);
    y:=y-18;
    GetImage(x,y,x+16,y+18,Nman);
    PutImage(x,y,Nman,1);
    BellString;
    for my:=y downto 37 do begin
      PutImage(x,my,Nman,1);
      Delay(80);
      PutImage(x,my,Nman,1);
    end;
    PutPic(Icon[5],299,55);
    Delay(700);
    Play('t100O5L4C#<ABE2');
    Delay(200);
    PutPic(Icon[19],301,35);
    Delay(200);
    Play('<EB>C#<A2');
    ShowScore(1000,On);
    Delay(200);
  end;

begin
  InitGame;
  repeat
    InitWall;
    PlayWall;
    if Reached then begin
      if WallNo<Walls then begin
        Pause:=0;
        repeat
          Sound(1000);
          Delay(17);
          Pause:=Pause+1;
          NoSound;
          Delay(Pause);
        until Pause>40;
      end;
      ShowScore(Bonus,On);
      if WallNo=Walls then DoEsmeralda;
      Inc(WallNo);
      if WallNo>12 then begin
        WallNo:=1;
        Inc(Level);
        if Level>3 then Level:=3;
      end;
    end else if Dead then begin
      PutPic(Behind,x,y);
      ClearObstacles;
      KillLife;
    end;
  until(Lives=0) or Quit;
  Quit:=False;
end;

procedure GameOver;
var Ctr:word;
begin
  SetTextStyle(GothicFont,0,2);
  SetTextJustify(CenterText,TopText);
  for Ctr:=0 to 1 do begin
    SetColor(2+Ctr); OutTextXY(158+Ctr*2,51-Ctr*2,'Game Over');
  end;
  SetTextStyle(DefaultFont,0,1);
  SetTextJustify(LeftText,TopText);
  Ctr:=1; LastPos:=0;
  repeat
    if Score>=Hisc[Ctr].Scor then LastPos:=Ctr;
    Inc(Ctr);
  until (LastPos<>0) or (Ctr>7);
  if LastPos<>0 then begin
    if LastPos<7 then for Ctr:=7 downto LastPos+1 do
      Hisc[Ctr]:=Hisc[Ctr-1];
    Hisc[LastPos].Scor:=Score;
    SetTextStyle(SmallFont,0,5);
    SetColor(1);
    SetTextJustify(CenterText,TopText);
    Wlin(70,'Good job! Enter your name:');
    Hisc[LastPos].Name:=GetInput(10,12,20,3);
  end else begin
    Play('t150l8o3ee4f#d4<b>dd2.');
    Key:=ReadKey;
  end;
end;

procedure ShutDown;
begin
  CloseGraph;
  TextMode(Co80);
  Writeln('You''ve just finished playing HUNCHBACK');
  Writeln('from '+Publ);
  Writeln('Welcome back for another try, Hunchy!');
  GotoXY(1,24);
  Halt;
end;

begin
  Initialize;
  repeat
    ShowTitle;
    if not Quit then begin
      Game;
      GameOver;
    end;
  until Quit;
  SaveHiScores;
  ShutDown;
end.